home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d3 / db4less3.arc / TIME.PRG < prev    next >
Text File  |  1990-06-16  |  15KB  |  481 lines
  1. ********************************************************************************
  2. * Program......: TIME
  3. * Author.......: Bruce Troutman
  4. * Date.........: 12-04-88
  5. * Notice.......: (c) Interco International, Ltd.
  6. * dBASE Ver....: dBase IV
  7. * Generated by.: APGEN version 1.0
  8. * Description..: Time File Manager
  9.  
  10. * Notes........:
  11. ********************************************************************************
  12.  
  13. SET CONSOLE OFF
  14. IF TYPE("gn_apgen") = "U"  && We were not called from another APGEN program
  15.    CLEAR ALL
  16.    CLEAR WINDOW
  17.    CLOSE ALL
  18.    gn_apgen = 1
  19. ELSE
  20.    gn_apgen = gn_apgen + 1 
  21.    PRIVATE gc_bell, gc_carry, gc_clock, gc_century, gc_confirm, gc_deli,;
  22.            gc_escape, gc_instruc, gc_safety, gc_status, gc_score, gc_talk
  23. ENDIF
  24.  
  25. *-- Window for pause message box (ON ERROR)
  26. DEFINE WINDOW Pause FROM 15,00 TO 19,79 DOUBLE
  27. ON ERROR DO PAUSE WITH [Error occurred on line ]+LTRIM(STR(LINE())) +[ of procedure ]+Program()
  28. ON KEY LABEL F1 DO quickhlp
  29.  
  30. *-- Store initial SETs to variables
  31. gc_bell   =SET("BELL")
  32. gc_carry  =SET("CARRY")
  33. gc_clock  =SET("CLOCK")
  34. gc_century=SET("CENTURY")
  35. gc_confirm=SET("CONFIRM")
  36. gc_deli   =SET("DELIMITERS")
  37. gc_escape =SET("ESCAPE")
  38. gc_instruc=SET("INSTRUCT")
  39. gc_safety =SET("SAFETY")
  40. gc_status =SET("STATUS")
  41. gc_score  =SET("SCOREBOARD")
  42. gc_talk   =SET("TALK")
  43.  
  44. SET CLOCK OFF
  45. SET COLOR TO
  46. CLEAR
  47. SET CONSOLE ON
  48.  
  49. *-- Sets for application
  50. SET BELL ON
  51. SET CARRY OFF
  52. SET CENTURY OFF
  53. SET CONFIRM OFF
  54. SET DELIMITERS TO ""
  55. SET DELIMITER OFF
  56. SET ESCAPE ON
  57. ***SET INSTRUCT OFF ** remove for RunTime
  58. SET SAFETY ON
  59. SET SCOREBOARD OFF
  60. SET STATUS OFF
  61. SET TALK OFF
  62.  
  63. *-- Set global variables
  64. gn_barv  = 0                 && Initialize bar value variable
  65. gn_error = 0                 && Variable to store error() number
  66. gn_send  = 0                 && Return variable from popup
  67. gc_brdr  = "2"               && Border style for menu box - See Procedure
  68. lc_heading = "Time File Manager" && Menu heading string
  69. ll_color = ISCOLOR()
  70.  
  71. CLEAR
  72. SET ESCAPE ON
  73. SET STATUS ON
  74. *-- Set colors
  75. IF ll_color
  76.    SET COLOR OF NORMAL TO w+/b
  77.    SET COLOR OF MESSAGES TO w+/b
  78.    SET COLOR OF TITLES TO w+/b
  79.    SET COLOR OF HIGHLIGHT TO b/w
  80.    SET COLOR OF BOX TO b/w
  81.    SET COLOR OF INFORMATION TO b/w
  82.    SET COLOR OF FIELDS TO b/w
  83. ENDIF
  84.  
  85. SET VIEW TO TIMEEDIT.VUE
  86.  
  87. *-- Define the main popup menu for Quickapp
  88. SET BORDER TO DOUBLE
  89. DEFINE POPUP quick FROM 7,27
  90. DEFINE BAR 1 OF quick PROMPT " Add Information" MESSAGE "Add records to database TIMEEDIT.VUE"
  91. DEFINE BAR 2 OF quick PROMPT " Change Information" MESSAGE "Edit records in database TIMEEDIT.VUE"
  92. DEFINE BAR 3 OF quick PROMPT " Browse Information" MESSAGE "Browse database TIMEEDIT.VUE"
  93. DEFINE BAR 4 OF quick PROMPT " Discard Marked Records " MESSAGE "Purge deleted records in database TIMEEDIT.VUE"
  94. DEFINE BAR 5 OF quick PROMPT " Print Report" MESSAGE "Run report form TIME"
  95. DEFINE BAR 6 OF quick PROMPT " Exit From Time" MESSAGE "Exit program to dBASE"
  96. ON SELECTION POPUP quick DO Action WITH BAR()
  97.  
  98. *-- Define the popup menu for print redirection
  99. DEFINE POPUP prntchk FROM 10,55
  100. DEFINE BAR 1 OF prntchk PROMPT " Send to..." SKIP
  101. DEFINE BAR 2 OF prntchk PROMPT REPLICATE(CHR(196),14) SKIP
  102. DEFINE BAR 3 OF prntchk PROMPT " Screen " MESSAGE "Screen only"
  103. DEFINE BAR 4 OF prntchk PROMPT " Printer " MESSAGE "Printer LPT1:"
  104. DEFINE BAR 5 OF prntchk PROMPT " Label Sample " MESSAGE "Printer LPT1: with Sample label"  SKIP
  105. DEFINE BAR 6 OF prntchk PROMPT " Return" MESSAGE "Return to Main Menu"
  106. ON SELECTION POPUP prntchk DO get_sele
  107.  
  108. *-- Window to cover work surface during edit, append, etc.
  109. DEFINE WINDOW work FROM 0,0 TO 21,79 NONE
  110.  
  111. *-- Window for area below menu heading & for running reports/labels in
  112. DEFINE WINDOW desktop FROM 4,0 TO 21,79 NONE
  113.  
  114. DEFINE WINDOW printemp FROM 10,25 TO 15,56
  115.  
  116. *-- Display heading centered on the screen.
  117. DO menubox WITH lc_heading
  118.  
  119. *-- Show the menu so we don't get a flash if the user hits arrow keys or ESC
  120. SHOW POPUP quick
  121. SAVE SCREEN TO quick
  122. *-- Display Quickapp menu centered on the screen.
  123. DO WHILE gn_barv <> 6 && Prevent user from exiting with arrow keys or ESC
  124.   ACTIVATE POPUP quick
  125. ENDDO
  126.  
  127. * Restore SET environment the best we can
  128. SET BELL &gc_bell.
  129. SET CARRY &gc_carry.
  130. SET CLOCK TO
  131. SET CLOCK &gc_clock.
  132. SET CENTURY &gc_century.
  133. SET CONFIRM &gc_confirm.
  134. SET DELIMITERS &gc_deli.
  135. SET ESCAPE &gc_escape.
  136. *** SET INSTRUCT &gc_instruc. ** Remove for RunTime
  137. SET STATUS &gc_status.
  138. SET SAFETY &gc_safety.
  139. SET SCORE  &gc_score.
  140. SET TALK   &gc_talk.
  141. SET FORMAT TO
  142.  
  143. IF gn_apgen = 1 && We were not called from another APGEN program
  144.    CLEAR WINDOW
  145.    CLEAR POPUP
  146.    CLEAR ALL
  147.    CLOSE ALL
  148. ELSE
  149.    RELEASE WINDOWS work, desktop 
  150.    RELEASE SCREEN quick
  151.    RELEASE POPUP quick
  152.    gn_apgen = gn_apgen - 1 
  153. ENDIF
  154. ON ERROR
  155. ON KEY LABEL F1
  156. RETURN
  157. * EOP: TIME.PRG
  158.  
  159. ********************************************************************************
  160. * Procedures...: TIME.Prc
  161. * Author.......: Bruce Troutman
  162. * Date.........: 12-04-88
  163. * Notice.......: (c) Interco International, Ltd.
  164. * dBASE Ver....: dBase IV
  165. * Generated by.: APGEN version 1.0
  166. * Description..: Time File Manager
  167.  
  168. * Notes........:
  169. ********************************************************************************
  170.  
  171. *-- Here is a sample procedure file to show the power of procdures.
  172. *-- This example - Menubox displays a menu heading box with a centered heading.
  173. PROCEDURE MenuBox
  174. PARAMETER lc_m_name
  175. *-- Parameter lc_m_name - is the title variable for the menu
  176. SET CLOCK OFF
  177. @ 1,0 FILL TO 2,79 COLOR n/n
  178. DO CASE
  179. CASE gc_brdr = "0"
  180.    @ 1,0 CLEAR TO 3,79
  181. CASE gc_brdr = "1"
  182.    @ 1,0 TO 3,79
  183. CASE gc_brdr = "2"
  184.    lc_color = IIF(ISCOLOR(),"b/w", "W+/N")
  185.    @ 1,0 TO 3,79 DOUBLE COLOR &lc_color.
  186. ENDCASE
  187. SET CLOCK TO 2,68
  188. @ 2,1 SAY SUBSTR(CDOW(DATE()),1,3)+'. '+DTOC(DATE())+' '
  189. @ 2,41 - (LEN(lc_m_name)/2) SAY lc_m_name
  190. lc_color = IIF(ISCOLOR(),"w+/b", "W+/N")
  191. @ 2,1 FILL TO 2,78 COLOR &lc_color.
  192. RETURN
  193.  
  194.  
  195. PROCEDURE get_sele
  196. *-- Get the user selection & store BAR into variable
  197. gn_send = BAR()  && Variable for print testing
  198. DEACTIVATE POPUP
  199. RETURN
  200.  
  201. PROCEDURE Action
  202. PARAMETERS bar
  203. *-- Get the user selection & store BAR into variable
  204. gn_barv = bar
  205. SET MESSAGE TO
  206. IF LTRIM( STR( gn_barv)) $ "123"
  207.    *-- Set format file TIME for edit/append/browse
  208.    SET FORMAT TO TIME
  209. ENDIF
  210. DO CASE
  211.    CASE gn_barv = 1
  212.       *-- Add information
  213.       SET MESSAGE TO 'Appending records to file TIMEEDIT.VUE'
  214.       APPEND
  215.    CASE gn_barv = 2
  216.       *-- Change information
  217.       SET MESSAGE TO 'Editing file TIMEEDIT.VUE'
  218.       EDIT
  219.    CASE gn_barv = 3
  220.       *-- Browse information
  221.       SET MESSAGE TO 'Browsing file TIMEEDIT.VUE'
  222.       BROWSE FORMAT 
  223.    CASE gn_barv = 4
  224.       *-- Remove information (Pack file timeedit.vue)
  225.       ACTIVATE WINDOW desktop
  226.       @ 2,0 SAY "Packing database TIMEEDIT.VUE to REMOVE records marked for deletion..."
  227.       @ 3,0
  228.       SET TALK ON
  229.       PACK
  230.       GO TOP
  231.       ?
  232.       WAIT
  233.       SET TALK OFF
  234.       DEACTIVATE WINDOW desktop
  235.    CASE gn_barv = 5
  236.       *-- Run report form time
  237.       SET MESSAGE TO 'Pick an option to locate a record or <ESC> for default'
  238.       ACTIVATE WINDOW work
  239.       gn_recno = RECNO()
  240.       DO position
  241.       DEACTIVATE WINDOW work
  242.       lc_toprnt = IIF(gn_recno <> recno(),'REST ','')
  243.       STORE 0 TO gn_send, gn_pkey
  244.       ACTIVATE POPUP prntchk
  245.       IF gn_send = 4
  246.          lc_toprnt = 'TO PRINT'
  247.          ON ERROR DO prntrtry
  248.       ENDIF
  249.       IF .NOT. gn_send = 6
  250.          SET MESSAGE TO 'Printing report TIME'
  251.          ACTIVATE WINDOW desktop
  252.          SET ESCAPE ON
  253.          REPORT FORM TIME &lc_toprnt.
  254.          IF gn_pkey <> 27
  255.             WAIT
  256.          ENDIF
  257.          SET ESCAPE ON
  258.          DEACTIVATE WINDOW desktop
  259.       ENDIF
  260.       GOTO gn_recno
  261.       ON ERROR DO PAUSE WITH [Error occurred on line ]+LTRIM(STR(LINE())) +[ of procedure ]+Program()
  262.    CASE gn_barv = 6
  263.       DEACTIVATE POPUP
  264. ENDCASE
  265. SET MESSAGE TO
  266. IF gc_status = "OFF"
  267.    SET STATUS ON
  268. ENDIF
  269. SET FORMAT TO
  270. RESTORE SCREEN FROM quick
  271. RETURN
  272.  
  273. PROCEDURE Pause
  274. PARAMETER lc_msg
  275. *-- Parameters : lc_msg = message line
  276. IF TYPE("lc_message")="U"
  277.    gn_error=ERROR()
  278. ENDIF
  279. lc_msg = lc_msg
  280. lc_option='0'
  281. ACTIVATE WINDOW Pause
  282. IF gn_error > 0
  283.    IF TYPE("lc_message")="U"
  284.       @ 0,1 SAY [An error has occurred !! - Error message: ]+MESSAGE()
  285.    ELSE
  286.       @ 0,1 SAY [Error # ]+lc_message
  287.    ENDIF
  288. ENDIF
  289. @ 1,1 SAY lc_msg
  290. WAIT " Press any key to continue..."
  291. DEACTIVATE WINDOW Pause
  292. RETURN
  293.  
  294.  
  295. PROCEDURE quickhlp
  296. *--  If you want to include help for a quickapp uncomment the lines below and
  297. *--  put your help @ say's into the case statements
  298. *ACTIVATE WINDOW desktop
  299. *CLEAR
  300. DO CASE
  301.   CASE BAR() = 1
  302.   CASE BAR() = 2
  303.   CASE BAR() = 3
  304.   CASE BAR() = 4
  305.   CASE BAR() = 5
  306.   CASE BAR() = 6
  307. ENDCASE
  308. *WAIT
  309. *DEACTIVATE WINDOW desktop
  310. RETURN
  311.  
  312. PROCEDURE Position
  313. IF LEN(DBF()) = 0
  314.    DO Pause WITH "Database not in use. "
  315.    RETURN
  316. ENDIF
  317. SET SPACE ON
  318. SET DELIMITERS OFF
  319. ln_type=0          && sublevel selection
  320. ln_rkey=READKEY()  && test for ESC or Return
  321. ln_rec=RECNO()     && DBF record number
  322. ln_num=0           && for input of a number
  323. ld_date=DATE()     && for input of a date
  324. lc_option='0'      && main option ie. Seek, Goto and Locate
  325. *-- Scope ie. ALL, REST, NEXT <n>
  326. STORE SPACE(10) TO lc_scp
  327. *-- 1 = Character SEEK, 2 = For clause, 3 = While clause
  328. STORE SPACE(40) TO lc_ln1, lc_ln2, lc_ln3
  329. lc_temp=""
  330. @ 0,00 SAY "Index order: "+IIF(""=ORDER(),"Database is in natural order",ORDER())
  331. @ 1,00 SAY "Listed below are the first 16 fields."
  332. lc_temp=REPLICATE(CHR(196),19)
  333. @ 2,0 SAY CHR(218)+lc_temp+CHR(194)+lc_temp+CHR(194)+lc_temp+CHR(194)+lc_temp
  334. ln_num=240
  335. DO WHILE ln_num < 560
  336.    lc_temp=FIELD( (ln_num-240)/20 +1)
  337.    @ (ln_num/80),MOD(ln_num,80) SAY CHR(179)+;
  338. lc_temp+SPACE(11-LEN(lc_temp))+;
  339. SUBSTR("= Char  = Date  = Logic = Num   = Float = Memo          ",;
  340. AT(TYPE(lc_temp),"CDLNFMU")*8-7,8)
  341.    ln_num=ln_num+20
  342. ENDDO
  343. ln_num=1
  344.  
  345. DEFINE POPUP Posit1 FROM 8,30
  346. DEFINE BAR 1 OF Posit1 PROMPT " Position by " SKIP
  347. DEFINE BAR 2 OF Posit1 PROMPT REPLICATE(CHR(196),15) SKIP
  348. DEFINE BAR 3 OF Posit1 PROMPT " SEEK Record" MESSAGE "Search on index key" SKIP FOR ""=ORDER()
  349. DEFINE BAR 4 OF Posit1 PROMPT " GOTO Record" MESSAGE "Position to specific record"
  350. DEFINE BAR 5 OF Posit1 PROMPT " LOCATE Record " MESSAGE "Locate record for condition"
  351. DEFINE BAR 6 OF Posit1 PROMPT " Return" MESSAGE "Return without positioning"
  352. ON SELECTION POPUP Posit1 DO get_sele
  353.  
  354. SET CONFIRM ON
  355. DO WHILE lc_option='0'
  356.   ACTIVATE POPUP Posit1
  357.   lc_option = ltrim(str(gn_send))  && for popup
  358.    IF LASTKEY() = 27 .OR. lc_option="6"
  359.       GOTO ln_rec
  360.       EXIT
  361.    ENDIF
  362.    DO CASE
  363.    CASE lc_option='3'
  364.       *-- Seek
  365.       IF LEN(NDX(1))=0 .AND. LEN(MDX(1))=0
  366.          DO Pause WITH "Can't use this option - No index files are open."
  367.          LOOP
  368.       ENDIF
  369.       ln_type=1
  370.       lc_ln1=SPACE(40)
  371.       DEFINE WINDOW Posit2 FROM 8,19 TO 15,62 DOUBLE
  372.       ACTIVATE WINDOW Posit2
  373.       @ 1,1 SAY "Enter the type of expression:" GET ln_type PICT "#" RANGE 1,3
  374.       @ 2,1 SAY "(1=character, 2=numeric and 3=date.)"
  375.       READ
  376.       IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  377.          SET CONFIRM ON
  378.          @ 3,1 SAY "Enter the key expression to search for:"
  379.          IF ln_type=3
  380.             @ 4,1 GET ld_date PICT "@D"
  381.          ELSE
  382.             IF ln_type=2
  383.                @ 4,1 GET ln_num PICT "##########"
  384.             ELSE
  385.                @ 4,1 GET lc_ln1
  386.             ENDIF
  387.          ENDIF
  388.          READ
  389.          SET CONFIRM OFF
  390.          IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  391.             lc_temp=IIF(ln_type=1,"TRIM(lc_ln1)",IIF(ln_type=2,"ln_num","ld_date"))
  392.             SEEK &lc_temp.
  393.          ENDIF
  394.       ENDIF
  395.       RELEASE WINDOWS Posit2
  396.    CASE lc_option='4'
  397.       *-- Goto
  398.       ln_type=1
  399.       DEFINE POPUP Posit2 FROM 8,30
  400.       DEFINE BAR 1 OF Posit2 PROMPT " GOTO:" SKIP 
  401.       DEFINE BAR 2 OF Posit2 PROMPT REPLICATE(CHR(196),10) SKIP 
  402.       DEFINE BAR 3 OF Posit2 PROMPT " TOP" MESSAGE "GOTO Top of File"
  403.       DEFINE BAR 4 OF Posit2 PROMPT " BOTTOM" MESSAGE "GOTO Bottom of File"
  404.       DEFINE BAR 5 OF Posit2 PROMPT " Record # " MESSAGE "GOTO A Specific Record"
  405.       ON SELECTION POPUP Posit2 DO get_sele
  406.       ACTIVATE POPUP posit2
  407.       ln_type = gn_send
  408.       IF LASTKEY() <> 27
  409.          IF ln_type=5
  410.             DEFINE WINDOW Posit2 FROM 8,26 TO 13,50 DOUBLE
  411.             ACTIVATE WINDOW Posit2
  412.             ln_num=0
  413.             @ 3,1 SAY "Max. Record # = "+LTRIM(STR(RECCOUNT()))
  414.             @ 1,1 SAY "Record to GOTO" GET ln_num PICT "######" RANGE 1,RECCOUNT()
  415.             READ
  416.             IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  417.                GOTO ln_num
  418.             ENDIF
  419.             RELEASE WINDOWS Posit2
  420.          ELSE
  421.            lc_temp=IIF(ln_type=3,"TOP","BOTTOM")
  422.            GOTO &lc_temp.
  423.          ENDIF
  424.       ENDIF
  425.    CASE lc_option='5'
  426.       *-- Locate
  427.       DEFINE WINDOW Posit2 FROM 8,16 TO 14,66 DOUBLE
  428.       ACTIVATE WINDOW Posit2
  429.       @ 1,19 SAY "ie. ALL, NEXT <n>, and REST"
  430.       @ 1,01 SAY "Scope:" GET lc_scp
  431.       @ 2,01 SAY "For:  " GET lc_ln2
  432.       @ 3,01 SAY "While:" GET lc_ln3
  433.       READ
  434.       IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  435.          lc_temp=TRIM(lc_scp)
  436.          lc_temp=lc_temp + IIF(LEN(TRIM(lc_ln2)) > 0," FOR "+TRIM(lc_ln2),"")
  437.          lc_temp=lc_temp + IIF(LEN(TRIM(lc_ln3)) > 0," WHILE "+TRIM(lc_ln3),"")
  438.          IF LEN(lc_temp) > 0
  439.             LOCATE &lc_temp.
  440.          ELSE
  441.             DO Pause WITH "All fields were blank."
  442.          ENDIF
  443.       ENDIF
  444.       RELEASE WINDOW Posit2
  445.    ENDCASE
  446.    IF EOF()
  447.       DO Pause WITH "Record not found."
  448.       GOTO ln_rec
  449.    ENDIF
  450.    IF READKEY()=12 .OR. READKEY()= 268 .OR. LASTKEY()=27  && Esc was hit
  451.       lc_option='0'
  452.    ENDIF
  453. ENDDO
  454. SET DELIMITERS &gc_deli.
  455. SET CONFIRM OFF
  456. RETURN
  457.  
  458.  
  459. PROC prntrtry
  460. PRIVATE lc_escape
  461. lc_escape = SET("ESCAPE")
  462. IF .NOT. PRINTSTATUS()
  463.    IF lc_escape = "ON"
  464.        SET ESCAPE OFF
  465.     ENDIF
  466.    gn_pkey = 0
  467.    ACTIVATE WINDOW printemp
  468.    @ 1,0 SAY "Please ready your printer or"
  469.    @ 2,0 SAY "     press ESC to cancel"
  470.    DO WHILE ( .NOT. PRINTSTATUS()) .AND. gn_pkey <> 27
  471.       gn_pkey = INKEY()
  472.    ENDDO
  473.    DEACTIVATE WINDOW printemp
  474.    SET ESCAPE &lc_escape
  475.    IF gn_pkey <> 27
  476.       RETRY
  477.    ENDIF
  478. ENDIF
  479. RETURN
  480. * EOF: TIME.PRG
  481.